DEVOIR 1 - Science des données

Eva Racine et Gayanée Tashjian - Groupe E

Devoir I : Concentration de la distribution des prénoms dans le temps et l’espace.

Importation des bases de données :

Ici, nous installons les packages nécessaires :

to_be_loaded <- c("tidyverse", 
                  "patchwork", 
                  "glue", 
                  "ggforce", 
                  "plotly",
                  "ggthemes",
                  "gapminder",
                  "ggrepel",
                  "here",
                  "ineq",
                  "DescTools",
                  "zoo")

for (pck in to_be_loaded) {
  if (!require(pck, character.only = TRUE, quietly = TRUE)) {
    install.packages(pck, repos="http://cran.rstudio.com/")
    suppressPackageStartupMessages(library(pck, character.only = TRUE))
  } else {
    suppressPackageStartupMessages(library(pck, character.only = TRUE))
  }
}

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## 
## Attaching package: 'plotly'
## 
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## 
## The following object is masked from 'package:graphics':
## 
##     layout
## 
## 
## here() starts at /Users/evaracine/FAC/B - MIASHS/L3/S6/SCIENCES DES DONNÉES
## 
## Registered S3 methods overwritten by 'DescTools':
##   method   from
##   lines.Lc ineq
##   plot.Lc  ineq
## 
## 
## Attaching package: 'DescTools'
## 
## 
## The following objects are masked from 'package:ineq':
## 
##     Atkinson, Gini, Herfindahl, Lc, Rosenbluth
## 
## 
## 
## Attaching package: 'zoo'
## 
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

Nous allons ensuite importer les bases de données Babynames pour les deux pays qui nous intéressent. Puis on les nomme df_us pour les USA, et df_fr pour la France.

Pour les US :

if (!require("babynames")){
  install.packages("babynames")
  stopifnot(require("babynames"), "Couldn't install and load package 'babynames'")
}

## Loading required package: babynames

df_us <- babynames |>
  mutate(country='us') |>
  mutate(sex=as_factor(sex))

tail(df_us)

## # A tibble: 6 × 6
##    year sex   name       n       prop country
##   <dbl> <fct> <chr>  <int>      <dbl> <chr>  
## 1  2017 M     Zyhier     5 0.00000255 us     
## 2  2017 M     Zykai      5 0.00000255 us     
## 3  2017 M     Zykeem     5 0.00000255 us     
## 4  2017 M     Zylin      5 0.00000255 us     
## 5  2017 M     Zylis      5 0.00000255 us     
## 6  2017 M     Zyrie      5 0.00000255 us

Pour la France :

path_data <- 'DATA'
fname <- 'nat2021_csv.zip'
fpath <- here(path_data, fname)
if (!file.exists(fpath)){
  url <- "https://www.insee.fr/fr/statistiques/fichier/2540004/nat2021_csv.zip"
  download.file(url, fpath)
}   

df_fr <- readr::read_csv2(fpath)

## ℹ Using "','" as decimal and "'.'" as grouping mark. Use `read_delim()` for more control.

## Rows: 686538 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## chr (2): preusuel, annais
## dbl (2): sexe, nombre
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

df_fr |> glimpse()

## Rows: 686,538
## Columns: 4
## $ sexe     <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ preusuel <chr> "_PRENOMS_RARES", "_PRENOMS_RARES", "_PRENOMS_RARES", "_PRENO…
## $ annais   <chr> "1900", "1901", "1902", "1903", "1904", "1905", "1906", "1907…
## $ nombre   <dbl> 1249, 1342, 1330, 1286, 1430, 1472, 1451, 1514, 1509, 1526, 1…

lkp <- list(year="annais",
  sex="sexe",
  name="preusuel",
  n="nombre")

df_fr <- df_fr |>
  rename(!!!lkp) |>
  mutate(country='fr') |>
  mutate(sex=as_factor(sex)) |>
  mutate(sex=fct_recode(sex, "M"="1", "F"="2")) |>
  mutate(sex=fct_relevel(sex, "F", "M")) |> 
  mutate(year=ifelse(year=="XXXX", NA, year)) |>
  mutate(year=as.integer(year)) |>
  arrange(year)

df_fr

## # A tibble: 686,538 × 5
##    sex   name            year     n country
##    <fct> <chr>          <int> <dbl> <chr>  
##  1 M     _PRENOMS_RARES  1900  1249 fr     
##  2 M     ABDON           1900     4 fr     
##  3 M     ABEL            1900   428 fr     
##  4 M     ABRAHAM         1900    19 fr     
##  5 M     ACHILLE         1900   205 fr     
##  6 M     ACHILLES        1900     6 fr     
##  7 M     ADALBERT        1900     7 fr     
##  8 M     ADAM            1900    20 fr     
##  9 M     ADELIN          1900     7 fr     
## 10 M     ADHEMAR         1900     5 fr     
## # ℹ 686,528 more rows

La base de donnée des USA n’est pas tout à fait la même que celle de la France. On va donc drop les années de 1880 à 1899 et la colonne “prop” de df_us et les années de 2018 à 2021 de df_fr. Ainsi, les deux tables auront exactement les mêmes années et colonnes.

df_us <- df_us |> select(-prop) |> subset(year>=1900)

df_fr <- df_fr |> subset(year<=2017)

df_us

## # A tibble: 1,872,400 × 5
##     year sex   name          n country
##    <dbl> <fct> <chr>     <int> <chr>  
##  1  1900 F     Mary      16706 us     
##  2  1900 F     Helen      6343 us     
##  3  1900 F     Anna       6114 us     
##  4  1900 F     Margaret   5304 us     
##  5  1900 F     Ruth       4765 us     
##  6  1900 F     Elizabeth  4096 us     
##  7  1900 F     Florence   3920 us     
##  8  1900 F     Ethel      3896 us     
##  9  1900 F     Marie      3856 us     
## 10  1900 F     Lillian    3414 us     
## # ℹ 1,872,390 more rows

df_fr

## # A tibble: 593,606 × 5
##    sex   name            year     n country
##    <fct> <chr>          <int> <dbl> <chr>  
##  1 M     _PRENOMS_RARES  1900  1249 fr     
##  2 M     ABDON           1900     4 fr     
##  3 M     ABEL            1900   428 fr     
##  4 M     ABRAHAM         1900    19 fr     
##  5 M     ACHILLE         1900   205 fr     
##  6 M     ACHILLES        1900     6 fr     
##  7 M     ADALBERT        1900     7 fr     
##  8 M     ADAM            1900    20 fr     
##  9 M     ADELIN          1900     7 fr     
## 10 M     ADHEMAR         1900     5 fr     
## # ℹ 593,596 more rows

Mesures de l’inégalité et de la diversité

Question 1 :

Calculer pour chaque année, sexe et pays les indicateurs suivants de la dispersion/concentration de la distribution des prénoms.

Courbe de Lorenz :

make_lorenz_df <- function(df) {  
  df |>
  group_by(year, sex) |>
  arrange(n) |>
  mutate(rr=row_number()/n(), L=cumsum(n)/sum(n),  p=n/sum(n)) |>
  ungroup()
}

#Pour la France :
df_lorenz_fr <- df_fr |> 
  filter(name != '_PRENOMS_RARES' &  !is.na(year)) |>
  make_lorenz_df()
df_lorenz_fr

## # A tibble: 593,369 × 8
##    sex   name        year     n country      rr         L         p
##    <fct> <chr>      <int> <dbl> <chr>     <dbl>     <dbl>     <dbl>
##  1 M     AGNAN       1900     3 fr      0.00138 0.0000170 0.0000170
##  2 M     ALFREDE     1900     3 fr      0.00277 0.0000341 0.0000170
##  3 M     ALLYRE      1900     3 fr      0.00415 0.0000511 0.0000170
##  4 M     ALMIR       1900     3 fr      0.00553 0.0000681 0.0000170
##  5 M     ALPHEE      1900     3 fr      0.00692 0.0000852 0.0000170
##  6 M     AMÉLIE      1900     3 fr      0.00830 0.000102  0.0000170
##  7 M     ANASTHASE   1900     3 fr      0.00968 0.000119  0.0000170
##  8 M     ANGE-MARIE  1900     3 fr      0.0111  0.000136  0.0000170
##  9 M     ANGELBERT   1900     3 fr      0.0124  0.000153  0.0000170
## 10 M     ANNIBAL     1900     3 fr      0.0138  0.000170  0.0000170
## # ℹ 593,359 more rows

#Pour les US :
df_lorenz_us <- df_us |> 
  make_lorenz_df()
df_lorenz_us

## # A tibble: 1,872,400 × 8
##     year sex   name         n country       rr         L         p
##    <dbl> <fct> <chr>    <int> <chr>      <dbl>     <dbl>     <dbl>
##  1  1900 F     Adabelle     5 us      0.000450 0.0000167 0.0000167
##  2  1900 F     Afton        5 us      0.000899 0.0000334 0.0000167
##  3  1900 F     Ailene       5 us      0.00135  0.0000500 0.0000167
##  4  1900 F     Alfhild      5 us      0.00180  0.0000667 0.0000167
##  5  1900 F     Algie        5 us      0.00225  0.0000834 0.0000167
##  6  1900 F     Alleine      5 us      0.00270  0.000100  0.0000167
##  7  1900 F     Almeter      5 us      0.00315  0.000117  0.0000167
##  8  1900 F     Alzada       5 us      0.00360  0.000133  0.0000167
##  9  1900 F     Alzina       5 us      0.00405  0.000150  0.0000167
## 10  1900 F     Amada        5 us      0.00450  0.000167  0.0000167
## # ℹ 1,872,390 more rows

row_number : rang/classement des prénoms par année et par sexe du plus au moins donné. C’est l’indice i dans lz formule mathématique de la courbe de Lorenz. (rang 1= prénom de moins donné dans l’année).

n() : calcule le nombre de prénoms donnés dans l’année par sexe.

sum(n) : nombre total de naissance par année et par sexe.

rr : le rang divisé par le nombre total de prénom par année et par sexe. Indice de rareté par année. Plus c’est grand(proche de 1) moins c’est rare. Plus c’est proche de 0, plus c’est rare.

cumsum(n) : somme cumulée du nombre de naissances.

p : la fréquence du prénom par année et par sexe.

1) Indice de Gini :

#Indice de Gini France :
p_gini_fr <- df_lorenz_fr |>
  group_by (year,sex) |>
  summarize(Gini=2*sum(rr*p)-1-1/n(), .groups='drop') |>
  mutate (country = 'FRANCE')

p_gini_fr

## # A tibble: 236 × 4
##     year sex    Gini country
##    <int> <fct> <dbl> <chr>  
##  1  1900 F     0.912 FRANCE 
##  2  1900 M     0.902 FRANCE 
##  3  1901 F     0.913 FRANCE 
##  4  1901 M     0.902 FRANCE 
##  5  1902 F     0.914 FRANCE 
##  6  1902 M     0.903 FRANCE 
##  7  1903 F     0.913 FRANCE 
##  8  1903 M     0.906 FRANCE 
##  9  1904 F     0.913 FRANCE 
## 10  1904 M     0.908 FRANCE 
## # ℹ 226 more rows

#Indice de Gini USA :
p_gini_us <- df_lorenz_us |>
  group_by (year,sex) |>
  summarize(Gini=2*sum(rr*p)-1-1/n(), .groups='drop')|>
  mutate (country = 'USA')
p_gini_us

## # A tibble: 236 × 4
##     year sex    Gini country
##    <dbl> <fct> <dbl> <chr>  
##  1  1900 F     0.863 USA    
##  2  1900 M     0.847 USA    
##  3  1901 F     0.852 USA    
##  4  1901 M     0.828 USA    
##  5  1902 F     0.855 USA    
##  6  1902 M     0.836 USA    
##  7  1903 F     0.856 USA    
##  8  1903 M     0.833 USA    
##  9  1904 F     0.858 USA    
## 10  1904 M     0.837 USA    
## # ℹ 226 more rows

#On joint les deux tables :
gini <- full_join(p_gini_fr,p_gini_us, by = c('sex', 'year', 'country', 'Gini'))
gini

## # A tibble: 472 × 4
##     year sex    Gini country
##    <dbl> <fct> <dbl> <chr>  
##  1  1900 F     0.912 FRANCE 
##  2  1900 M     0.902 FRANCE 
##  3  1901 F     0.913 FRANCE 
##  4  1901 M     0.902 FRANCE 
##  5  1902 F     0.914 FRANCE 
##  6  1902 M     0.903 FRANCE 
##  7  1903 F     0.913 FRANCE 
##  8  1903 M     0.906 FRANCE 
##  9  1904 F     0.913 FRANCE 
## 10  1904 M     0.908 FRANCE 
## # ℹ 462 more rows

2) Entropie de Shannon :

#Entropie de Shannon, fonction :
p_shannon <- function(df, co) { 
  df |>
  group_by(year, sex) |>
  mutate(p=n/sum(n)) |>
  summarize(Shannon=sum(p*log(p, base = 2)), .groups='drop') |>
  mutate (country = co )
}

#Entropie de Shannon pour la France :
p_shannon_fr <- p_shannon(df_fr, 'FRANCE')
p_shannon_fr

## # A tibble: 236 × 4
##     year sex   Shannon country
##    <int> <fct>   <dbl> <chr>  
##  1  1900 F       -6.21 FRANCE 
##  2  1900 M       -6.32 FRANCE 
##  3  1901 F       -6.23 FRANCE 
##  4  1901 M       -6.30 FRANCE 
##  5  1902 F       -6.25 FRANCE 
##  6  1902 M       -6.29 FRANCE 
##  7  1903 F       -6.28 FRANCE 
##  8  1903 M       -6.28 FRANCE 
##  9  1904 F       -6.28 FRANCE 
## 10  1904 M       -6.29 FRANCE 
## # ℹ 226 more rows

#Entropie de Shannon pour les US, sans la fonction :
p_shannon_us <- p_shannon(df_us, "USA")

p_shannon_us

## # A tibble: 236 × 4
##     year sex   Shannon country
##    <dbl> <fct>   <dbl> <chr>  
##  1  1900 F       -8.22 USA    
##  2  1900 M       -7.55 USA    
##  3  1901 F       -8.19 USA    
##  4  1901 M       -7.50 USA    
##  5  1902 F       -8.20 USA    
##  6  1902 M       -7.54 USA    
##  7  1903 F       -8.21 USA    
##  8  1903 M       -7.56 USA    
##  9  1904 F       -8.23 USA    
## 10  1904 M       -7.61 USA    
## # ℹ 226 more rows

#On joint les deux tables :
shannon <- full_join(p_shannon_fr, p_shannon_us, by = c('country','sex', 'year','Shannon'))
shannon

## # A tibble: 472 × 4
##     year sex   Shannon country
##    <dbl> <fct>   <dbl> <chr>  
##  1  1900 F       -6.21 FRANCE 
##  2  1900 M       -6.32 FRANCE 
##  3  1901 F       -6.23 FRANCE 
##  4  1901 M       -6.30 FRANCE 
##  5  1902 F       -6.25 FRANCE 
##  6  1902 M       -6.29 FRANCE 
##  7  1903 F       -6.28 FRANCE 
##  8  1903 M       -6.28 FRANCE 
##  9  1904 F       -6.28 FRANCE 
## 10  1904 M       -6.29 FRANCE 
## # ℹ 462 more rows

Nous vérifions rapidement si les données trouvées sont bonnes grâce à la fonction Entropy du package ineq, en utilisant, par exemple, l’année 1900 et le sexe M pour la France :

shannon_fr_test <- df_lorenz_fr |> filter(year==1900 & sex=='M')
Entropy(shannon_fr_test$p, base=2)

## [1] 6.301048

3) Entropie de Rényi (ordre 2) :

#Entropie de Rényi, fonction :
p_renyi <- function(df, co){
  df |>
  group_by(year,sex) |>
  arrange(n) |>
  mutate(p=n/sum(n)) |>
  summarize(Renyi=-log(sum(p**2),base = 2), .groups='drop') |>
  mutate (country = co )
}

#Pour la France :
p_renyi_fr <- p_renyi(df_fr, 'FRANCE')
p_renyi_fr

## # A tibble: 236 × 4
##     year sex   Renyi country
##    <int> <fct> <dbl> <chr>  
##  1  1900 F      4.23 FRANCE 
##  2  1900 M      5.34 FRANCE 
##  3  1901 F      4.25 FRANCE 
##  4  1901 M      5.32 FRANCE 
##  5  1902 F      4.30 FRANCE 
##  6  1902 M      5.31 FRANCE 
##  7  1903 F      4.36 FRANCE 
##  8  1903 M      5.31 FRANCE 
##  9  1904 F      4.39 FRANCE 
## 10  1904 M      5.31 FRANCE 
## # ℹ 226 more rows

#Pour les US :
p_renyi_us <- p_renyi(df_us, 'USA')
p_renyi_us

## # A tibble: 236 × 4
##     year sex   Renyi country
##    <dbl> <fct> <dbl> <chr>  
##  1  1900 F      6.83 USA    
##  2  1900 M      5.86 USA    
##  3  1901 F      6.83 USA    
##  4  1901 M      5.90 USA    
##  5  1902 F      6.83 USA    
##  6  1902 M      5.92 USA    
##  7  1903 F      6.83 USA    
##  8  1903 M      5.94 USA    
##  9  1904 F      6.83 USA    
## 10  1904 M      5.98 USA    
## # ℹ 226 more rows

#On joint les deux tables :
renyi <- full_join(p_renyi_fr, p_renyi_us, by = c('country','sex', 'year','Renyi'))
renyi

## # A tibble: 472 × 4
##     year sex   Renyi country
##    <dbl> <fct> <dbl> <chr>  
##  1  1900 F      4.23 FRANCE 
##  2  1900 M      5.34 FRANCE 
##  3  1901 F      4.25 FRANCE 
##  4  1901 M      5.32 FRANCE 
##  5  1902 F      4.30 FRANCE 
##  6  1902 M      5.31 FRANCE 
##  7  1903 F      4.36 FRANCE 
##  8  1903 M      5.31 FRANCE 
##  9  1904 F      4.39 FRANCE 
## 10  1904 M      5.31 FRANCE 
## # ℹ 462 more rows

4) Majorité minimale d’Alker :

#Fonction :
p_alker <- function(lorenz, co){
  lorenz |> arrange(year,sex) |> filter(L>0.5) |>
  group_by(year,sex) |>
  summarize(Alker=min(rr), .groups='drop')|>
  mutate (country = co )
}

#Pour la France :
p_alker_fr <- p_alker(df_lorenz_fr, 'FRANCE')
p_alker_fr

## # A tibble: 236 × 4
##     year sex   Alker country
##    <int> <fct> <dbl> <chr>  
##  1  1900 F     0.987 FRANCE 
##  2  1900 M     0.982 FRANCE 
##  3  1901 F     0.987 FRANCE 
##  4  1901 M     0.982 FRANCE 
##  5  1902 F     0.987 FRANCE 
##  6  1902 M     0.982 FRANCE 
##  7  1903 F     0.987 FRANCE 
##  8  1903 M     0.982 FRANCE 
##  9  1904 F     0.987 FRANCE 
## 10  1904 M     0.983 FRANCE 
## # ℹ 226 more rows

#Pour les USA :
p_alker_us <- p_alker(df_lorenz_us, 'USA')
p_alker_us

## # A tibble: 236 × 4
##     year sex   Alker country
##    <dbl> <fct> <dbl> <chr>  
##  1  1900 F     0.978 USA    
##  2  1900 M     0.984 USA    
##  3  1901 F     0.975 USA    
##  4  1901 M     0.980 USA    
##  5  1902 F     0.976 USA    
##  6  1902 M     0.981 USA    
##  7  1903 F     0.977 USA    
##  8  1903 M     0.980 USA    
##  9  1904 F     0.977 USA    
## 10  1904 M     0.981 USA    
## # ℹ 226 more rows

#On joint les deux tables :
alker <- full_join(p_alker_fr, p_alker_us, by = c('country','sex', 'year','Alker'))
alker

## # A tibble: 472 × 4
##     year sex   Alker country
##    <dbl> <fct> <dbl> <chr>  
##  1  1900 F     0.987 FRANCE 
##  2  1900 M     0.982 FRANCE 
##  3  1901 F     0.987 FRANCE 
##  4  1901 M     0.982 FRANCE 
##  5  1902 F     0.987 FRANCE 
##  6  1902 M     0.982 FRANCE 
##  7  1903 F     0.987 FRANCE 
##  8  1903 M     0.982 FRANCE 
##  9  1904 F     0.987 FRANCE 
## 10  1904 M     0.983 FRANCE 
## # ℹ 462 more rows

5) Part du dernier décile :

a=0.1

#Fonction
p_decile <- function(lorenz, co) {  
  lorenz |> arrange(year,sex) |> filter(rr>=1-a) |>
  group_by(year, sex) |>
  summarize(Decile=1-min(L), .groups = 'drop') |>
  arrange(year)|>
  mutate (country = co )
}

#Pour la France :
p_decile_fr <- p_decile(df_lorenz_fr, 'FRANCE')
p_decile_fr

## # A tibble: 236 × 4
##     year sex   Decile country
##    <int> <fct>  <dbl> <chr>  
##  1  1900 F      0.891 FRANCE 
##  2  1900 M      0.877 FRANCE 
##  3  1901 F      0.893 FRANCE 
##  4  1901 M      0.876 FRANCE 
##  5  1902 F      0.894 FRANCE 
##  6  1902 M      0.879 FRANCE 
##  7  1903 F      0.895 FRANCE 
##  8  1903 M      0.883 FRANCE 
##  9  1904 F      0.894 FRANCE 
## 10  1904 M      0.887 FRANCE 
## # ℹ 226 more rows

#Pour les US :
p_decile_us <- p_decile(df_lorenz_us, 'USA')
p_decile_us

## # A tibble: 236 × 4
##     year sex   Decile country
##    <dbl> <fct>  <dbl> <chr>  
##  1  1900 F      0.834 USA    
##  2  1900 M      0.808 USA    
##  3  1901 F      0.815 USA    
##  4  1901 M      0.781 USA    
##  5  1902 F      0.822 USA    
##  6  1902 M      0.792 USA    
##  7  1903 F      0.823 USA    
##  8  1903 M      0.787 USA    
##  9  1904 F      0.826 USA    
## 10  1904 M      0.794 USA    
## # ℹ 226 more rows

#On joint les deux tables :
decile <- full_join(p_decile_fr, p_decile_us, by = c('country','sex', 'year','Decile'))
decile

## # A tibble: 472 × 4
##     year sex   Decile country
##    <dbl> <fct>  <dbl> <chr>  
##  1  1900 F      0.891 FRANCE 
##  2  1900 M      0.877 FRANCE 
##  3  1901 F      0.893 FRANCE 
##  4  1901 M      0.876 FRANCE 
##  5  1902 F      0.894 FRANCE 
##  6  1902 M      0.879 FRANCE 
##  7  1903 F      0.895 FRANCE 
##  8  1903 M      0.883 FRANCE 
##  9  1904 F      0.894 FRANCE 
## 10  1904 M      0.887 FRANCE 
## # ℹ 462 more rows

6) Indice d’Atkinson :

#Indice d'Atkinson, fonction :
a=0.5

p_atkinson <- function(df, co){
  df |>
  group_by(year,sex) |>
  mutate(p=n/sum(n)) |>
  summarize(Atkinson = 1 - (1/n()) * (sum(p**(1-a)))**(1/(1-a)), .groups = 'drop')|>
  mutate (country = co )
}

#Pour la France :
p_atkin_fr <- p_atkinson(df_fr, 'FRANCE')
p_atkin_fr

## # A tibble: 236 × 4
##     year sex   Atkinson country
##    <int> <fct>    <dbl> <chr>  
##  1  1900 F        0.756 FRANCE 
##  2  1900 M        0.732 FRANCE 
##  3  1901 F        0.758 FRANCE 
##  4  1901 M        0.733 FRANCE 
##  5  1902 F        0.760 FRANCE 
##  6  1902 M        0.735 FRANCE 
##  7  1903 F        0.759 FRANCE 
##  8  1903 M        0.743 FRANCE 
##  9  1904 F        0.759 FRANCE 
## 10  1904 M        0.746 FRANCE 
## # ℹ 226 more rows

#Pour les US :
p_atkin_us <- p_atkinson(df_us, 'USA')
p_atkin_us

## # A tibble: 236 × 4
##     year sex   Atkinson country
##    <dbl> <fct>    <dbl> <chr>  
##  1  1900 F        0.654 USA    
##  2  1900 M        0.632 USA    
##  3  1901 F        0.634 USA    
##  4  1901 M        0.599 USA    
##  5  1902 F        0.641 USA    
##  6  1902 M        0.611 USA    
##  7  1903 F        0.643 USA    
##  8  1903 M        0.606 USA    
##  9  1904 F        0.646 USA    
## 10  1904 M        0.613 USA    
## # ℹ 226 more rows

#On joint les deux tables :
atkinson <- full_join(p_atkin_fr, p_atkin_us, by = c('country','sex', 'year','Atkinson'))
atkinson

## # A tibble: 472 × 4
##     year sex   Atkinson country
##    <dbl> <fct>    <dbl> <chr>  
##  1  1900 F        0.756 FRANCE 
##  2  1900 M        0.732 FRANCE 
##  3  1901 F        0.758 FRANCE 
##  4  1901 M        0.733 FRANCE 
##  5  1902 F        0.760 FRANCE 
##  6  1902 M        0.735 FRANCE 
##  7  1903 F        0.759 FRANCE 
##  8  1903 M        0.743 FRANCE 
##  9  1904 F        0.759 FRANCE 
## 10  1904 M        0.746 FRANCE 
## # ℹ 462 more rows

On vérifie rapidement si les données trouvées sont bonnes grâce à la fonction Atkinson du package ineq. Ici, on a fixé le paramètre alpha à 0.5 comme au dessus. :

atkinson_fr_test <- df_lorenz_fr |> filter(year==1900 & sex=='M')
Atkinson(atkinson_fr_test$p, parameter = 0.5, na.rm = TRUE)

## [1] 0.7328435

Création de la table où chaque ligne correspond à un pays, une année, un sexe (la clé) et une colonne par indicateur :

A <- merge(gini, shannon, by = c('country','sex', 'year'))
B <- merge(A, renyi, by = c('country','sex', 'year'))
C <- merge(B, alker, by = c('country','sex', 'year'))
D <- merge(C, decile, by = c('country','sex', 'year'))
E <- merge(D, atkinson, by = c('country','sex', 'year'))

indicateurs <- E |> arrange (year)
head(indicateurs)

##   country sex year      Gini   Shannon    Renyi     Alker    Decile  Atkinson
## 1  FRANCE   F 1900 0.9116964 -6.212928 4.225040 0.9867752 0.8908853 0.7559698
## 2  FRANCE   M 1900 0.9016836 -6.317148 5.336395 0.9820194 0.8765911 0.7318710
## 3     USA   F 1900 0.8625660 -8.220351 6.828812 0.9784173 0.8339693 0.6542068
## 4     USA   M 1900 0.8469594 -7.547574 5.856137 0.9840637 0.8075862 0.6320653
## 5  FRANCE   F 1901 0.9126356 -6.233539 4.251018 0.9871287 0.8933395 0.7577341
## 6  FRANCE   M 1901 0.9022316 -6.301738 5.323439 0.9819193 0.8760572 0.7330794

Question 2 :

Tracer les graphes de l’évolution de ces indicateurs de la dispersion/concentration de la distribution. Utiliser le mécanisme des facettes pour juxtaposer les graphes correspondants aux quatre couples (Pays, Sexe). Pour chaque (Pays, Sexe), superposez les graphes des indicateurs en fonction du temps.

On trace chacun des indicateurs :

g_gini <- ggplot(gini) +
  aes(x=year, y=Gini, group=sex)+
  geom_line(aes(color=sex))

g_gini+facet_grid(sex~country) +
  labs(title="Évolution de l'Indice de Gini par pays et par sexe")+
  xlab("années") +
  ylab("indice de Gini") +
  theme(plot.title = element_text(size=12, face="bold", hjust = 0.5),
        legend.position = "bottom" , 
        axis.title.x = element_text(size=8, face="bold", hjust = 0.5),
        axis.title.y = element_text(size=8, face="bold", hjust = 0.5))

g_shannon<- ggplot(shannon) +
  aes(x=year, y=Shannon, group=sex)+
  geom_line(aes(color=sex))

g_shannon+facet_grid(sex~country) +
  labs(title="Évolution de l'Entropie de Shannon par pays et par sexe")+
  xlab("années") +
  ylab("entropie de Shannon") +
  theme(plot.title = element_text(size=12, face="bold", hjust = 0.5),
        legend.position = "bottom" , 
        axis.title.x = element_text(size=8, face="bold", hjust = 0.5),
        axis.title.y = element_text(size=8, face="bold", hjust = 0.5))

g_renyi <- ggplot(renyi) +
  aes(x=year, y=Renyi, group=sex)+
  geom_line(aes(color=sex))

g_renyi+facet_grid(sex~country) +
  labs(title="Évolution de l'Entropie de Renyi par pays et par sexe")+
  xlab("années") +
  ylab("entropie de Renyi") +
  theme(plot.title = element_text(size=12, face="bold", hjust = 0.5),
        legend.position = "bottom" , 
        axis.title.x = element_text(size=8, face="bold", hjust = 0.5),
        axis.title.y = element_text(size=8, face="bold", hjust = 0.5))

g_alker <- ggplot(alker) +
  aes(x=year, y=Alker, group=sex)+
  geom_line(aes(color=sex))

g_alker+facet_grid(sex~country) +
  labs(title="Évolution de la majorité minimale d'Alker par pays et par sexe")+
  xlab("années") +
  ylab("majorité minimale d'Alker") +
  theme(plot.title = element_text(size=12, face="bold", hjust = 0.5),
        legend.position = "bottom" , 
        axis.title.x = element_text(size=8, face="bold", hjust = 0.5),
        axis.title.y = element_text(size=8, face="bold", hjust = 0.5))

g_decile <- ggplot(decile) +
  aes(x=year, y=Decile, group=sex)+
  geom_line(aes(color=sex))

g_decile+facet_grid(sex~country) +
  labs(title="Évolution de la part du dernier décile par pays et par sexe")+
  xlab("années") +
  ylab("part du dernier décile") +
  theme(plot.title = element_text(size=12, face="bold", hjust = 0.5),
        legend.position = "bottom" , 
        axis.title.x = element_text(size=8, face="bold", hjust = 0.5),
        axis.title.y = element_text(size=8, face="bold", hjust = 0.5))

g_atkinson <- ggplot(atkinson) +
  aes(x=year, y=Atkinson, group=sex)+
  geom_line(aes(color=sex))

g_atkinson+facet_grid(sex~country) +
  labs(title="Évolution de l'Indice d'Atkinson par pays et par sexe")+
  xlab("années") +
  ylab("indice d'Atkinson") +
  theme(plot.title = element_text(size=12, face="bold", hjust = 0.5),
        legend.position = "bottom" , 
        axis.title.x = element_text(size=8, face="bold", hjust = 0.5),
        axis.title.y = element_text(size=8, face="bold", hjust = 0.5))

On trace tous les indicateurs sur la même facet_grid :

indicateurs_long <- indicateurs |>
  pivot_longer(cols = c(-country, -sex, -year), names_to = "indicateur", values_to = "valeur")

indicateurs_long

## # A tibble: 2,832 × 5
##    country sex    year indicateur valeur
##    <chr>   <fct> <dbl> <chr>       <dbl>
##  1 FRANCE  F      1900 Gini        0.912
##  2 FRANCE  F      1900 Shannon    -6.21 
##  3 FRANCE  F      1900 Renyi       4.23 
##  4 FRANCE  F      1900 Alker       0.987
##  5 FRANCE  F      1900 Decile      0.891
##  6 FRANCE  F      1900 Atkinson    0.756
##  7 FRANCE  M      1900 Gini        0.902
##  8 FRANCE  M      1900 Shannon    -6.32 
##  9 FRANCE  M      1900 Renyi       5.34 
## 10 FRANCE  M      1900 Alker       0.982
## # ℹ 2,822 more rows

 g_indicateurs <- ggplot(indicateurs_long) +
  aes(x = year, y = valeur, group = indicateur, color = indicateur) +
  geom_line(aes(color=indicateur))+
  scale_y_continuous(sec.axis = sec_axis(~ . -10))+
  facet_grid(sex ~ country, scales = "free") +
  labs(title = "Évolution des Indicateurs par pays et par sexe",
       x = "Année",
       y = "Valeur",
       color = "Indicateurs",
       subtitle = "Comparaison des indicateurs") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom",
        axis.title.x = element_text(size = 8, face = "bold", hjust = 0.5),
        axis.title.y = element_text(size = 8, face = "bold", hjust = 0.5))
 
graphe<- ggplotly(g_indicateurs, dynamicTicks = TRUE)
config(graphe, scrollZoom=TRUE)

Avec la fonction ggplotly (du package plotly), on crée un graphique interactif qui nous permet de zoomer. En effet, Shannon et Renyi ne sont pas à la même échelle, ce qui fait qu’on ne distingue pas toutes les autres courbes. Avec ggplotly et en plaçant notre curseur sur l’axe des valeurs, on peut zoomer à plus petite échelle et ainsi les courbes de Alker, Atkinson, Gini et de la part du dernier décile se distinguent.

Ajustement à une loi de Zipf

Question 3 :

On crée la table de données que nous allons étudier :

name_fr_select <- df_fr |> filter(year %in% c(1950,1990,2015))

name_us_select <- df_us |> filter(year %in% c(1950,1990,2015))

popularite_desc <- function(df){
  df|>
  group_by(year,sex)  |> 
  arrange(desc(n)) |>
  mutate(rr=row_number(), p=n/sum(n))
}

pop_fr <- popularite_desc(name_fr_select)
pop_fr

## # A tibble: 24,032 × 7
## # Groups:   year, sex [6]
##    sex   name            year     n country    rr      p
##    <fct> <chr>          <int> <dbl> <chr>   <int>  <dbl>
##  1 M     JEAN            1950 38306 fr          1 0.0846
##  2 F     MARIE           1950 28061 fr          1 0.0650
##  3 M     MICHEL          1950 27956 fr          2 0.0617
##  4 F     _PRENOMS_RARES  2015 26827 fr          1 0.0702
##  5 M     _PRENOMS_RARES  2015 24925 fr          1 0.0620
##  6 M     ALAIN           1950 24047 fr          3 0.0531
##  7 M     GÉRARD          1950 18617 fr          4 0.0411
##  8 M     BERNARD         1950 18355 fr          5 0.0405
##  9 M     DANIEL          1950 18225 fr          6 0.0402
## 10 M     CHRISTIAN       1950 17040 fr          7 0.0376
## # ℹ 24,022 more rows

pop_us <- popularite_desc(name_us_select)
pop_us

## # A tibble: 68,119 × 7
## # Groups:   year, sex [6]
##     year sex   name            n country    rr      p
##    <dbl> <fct> <chr>       <int> <chr>   <int>  <dbl>
##  1  1950 M     James       86239 us          1 0.0482
##  2  1950 M     Robert      83565 us          2 0.0467
##  3  1950 F     Linda       80432 us          1 0.0469
##  4  1950 M     John        79420 us          3 0.0444
##  5  1950 F     Mary        65482 us          2 0.0382
##  6  1990 M     Michael     65282 us          1 0.0318
##  7  1950 M     Michael     65151 us          4 0.0364
##  8  1950 M     David       60730 us          5 0.0339
##  9  1950 M     William     60690 us          6 0.0339
## 10  1990 M     Christopher 52332 us          2 0.0255
## # ℹ 68,109 more rows

Nous pouvons ainsi tracer les diagrammes de Zipf :

#Pour la France :
zipf_France <- ggplot(pop_fr) +
  aes(x = log(rr), y = log(p), group = year, color = as.factor(year)) +
  geom_point()+
  facet_grid(sex~., scales = "free") +
  labs(title = "Diagramme de Zipf pour la France \npour les années 1950,1990,2015",
       x = "Rang du prénom à l'échelle logarithmique",
       y = "Popularité du prénom à l'échelle logarithmique",
       color = "Années") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom")

zipf_USA <- ggplot(pop_us) +
  aes(x = log(rr), y = log(p), group = year, color = as.factor(year)) +
  geom_point()+
  facet_grid(sex~., scales = "free") +
  labs(title = "Diagramme de Zipf pour les USA \npour les années 1950,1990,2015",
       x = "Rang du prénom à l'échelle logarithmique",
       y = "Popularité du prénom à l'échelle logarithmique",
       color = "Années") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom")

zipf_France + zipf_USA

Profils de popularité

Question 4 :

On commence par filtrer la base de données et en créée une nouvelle avec les années qui nous intéressent, c’est-à-dire les années depuis 1948.

#Pour la France :
name_fr_48 <- df_fr |> filter(name != '_PRENOMS_RARES' &  !is.na(year) & year >=1948)

#Pour les US :
name_us_48 <- df_us |> filter(name != '_PRENOMS_RARES' &  !is.na(year) & year >=1948)

Ensuite, on va selectionner les prénoms qui ont figurés au moins une fois parmi les 300 prénoms les plus populaires depuis 1948 pour les deux pays :

#Pour la France :
name_fr_300 <- name_fr_48 |> 
  group_by(year,sex) |>
  arrange(desc(n)) |> #car pour le n est grand, plus le prénom a été donné. Donc on veut les ranger par ordre décroissant afin de les numéroter du plus donné au moins donné.
  mutate(rr=row_number(),p=n/sum(n)) |> #rr est le rang et p la popularité. On aura besoin de p pour faire la moyenne mobile.
  filter(rr<=300) |>
  arrange(name,year,sex)

name_fr_300

## # A tibble: 42,000 × 7
## # Groups:   year, sex [140]
##    sex   name   year     n country    rr        p
##    <fct> <chr> <int> <dbl> <chr>   <int>    <dbl>
##  1 M     AARON  2004   335 fr        206 0.000865
##  2 M     AARON  2005   439 fr        168 0.00113 
##  3 M     AARON  2006   598 fr        120 0.00150 
##  4 M     AARON  2007   910 fr         83 0.00231 
##  5 M     AARON  2008  1380 fr         59 0.00346 
##  6 M     AARON  2009  1355 fr         56 0.00343 
##  7 M     AARON  2010  1606 fr         50 0.00403 
##  8 M     AARON  2011  1765 fr         43 0.00450 
##  9 M     AARON  2012  1728 fr         44 0.00440 
## 10 M     AARON  2013  1907 fr         41 0.00492 
## # ℹ 41,990 more rows

#Pour les US :
name_us_300 <- name_us_48 |> 
  group_by(year,sex) |>
  arrange(desc(n)) |>
  mutate(rr=row_number(), p=n/sum(n)) |>
  filter(rr<=300) |>
  arrange(name,year,sex)

name_us_300

## # A tibble: 42,000 × 7
## # Groups:   year, sex [140]
##     year sex   name        n country    rr        p
##    <dbl> <fct> <chr>   <int> <chr>   <int>    <dbl>
##  1  2009 M     Aaden    1267 us        271 0.000640
##  2  1994 F     Aaliyah  1451 us        202 0.000813
##  3  1995 F     Aaliyah  1255 us        225 0.000714
##  4  1997 F     Aaliyah  1739 us        176 0.000999
##  5  1998 F     Aaliyah  1399 us        222 0.000792
##  6  1999 F     Aaliyah  1088 us        286 0.000614
##  7  2000 F     Aaliyah  1496 us        211 0.000824
##  8  2001 F     Aaliyah  3352 us         96 0.00186 
##  9  2002 F     Aaliyah  4778 us         64 0.00266 
## 10  2003 F     Aaliyah  3672 us         90 0.00201 
## # ℹ 41,990 more rows

Ensuite, on va essayer de calculer les moyennes mobiles des popularités. On utilise la fonction rollmeanr du package zoo trouvée sur https://stackoverflow.com/questions/16193333/moving-average-of-previous-three-values-in-r.

name_fr_rm <- name_fr_300 |> group_by(name) |>
  mutate(moy_mobile = rollmeanr(p,4, fill=NA))
name_fr_rm

## # A tibble: 42,000 × 8
## # Groups:   name [1,857]
##    sex   name   year     n country    rr        p moy_mobile
##    <fct> <chr> <int> <dbl> <chr>   <int>    <dbl>      <dbl>
##  1 M     AARON  2004   335 fr        206 0.000865   NA      
##  2 M     AARON  2005   439 fr        168 0.00113    NA      
##  3 M     AARON  2006   598 fr        120 0.00150    NA      
##  4 M     AARON  2007   910 fr         83 0.00231     0.00145
##  5 M     AARON  2008  1380 fr         59 0.00346     0.00210
##  6 M     AARON  2009  1355 fr         56 0.00343     0.00267
##  7 M     AARON  2010  1606 fr         50 0.00403     0.00331
##  8 M     AARON  2011  1765 fr         43 0.00450     0.00386
##  9 M     AARON  2012  1728 fr         44 0.00440     0.00409
## 10 M     AARON  2013  1907 fr         41 0.00492     0.00446
## # ℹ 41,990 more rows

name_us_rm <- name_us_300 |> group_by(name) |>
  mutate(moy_mobile = rollmeanr(p,4, fill=NA))
name_us_rm

## # A tibble: 42,000 × 8
## # Groups:   name [1,608]
##     year sex   name        n country    rr        p moy_mobile
##    <dbl> <fct> <chr>   <int> <chr>   <int>    <dbl>      <dbl>
##  1  2009 M     Aaden    1267 us        271 0.000640  NA       
##  2  1994 F     Aaliyah  1451 us        202 0.000813  NA       
##  3  1995 F     Aaliyah  1255 us        225 0.000714  NA       
##  4  1997 F     Aaliyah  1739 us        176 0.000999  NA       
##  5  1998 F     Aaliyah  1399 us        222 0.000792   0.000829
##  6  1999 F     Aaliyah  1088 us        286 0.000614   0.000780
##  7  2000 F     Aaliyah  1496 us        211 0.000824   0.000807
##  8  2001 F     Aaliyah  3352 us         96 0.00186    0.00102 
##  9  2002 F     Aaliyah  4778 us         64 0.00266    0.00149 
## 10  2003 F     Aaliyah  3672 us         90 0.00201    0.00184 
## # ℹ 41,990 more rows

Nous allons étudier les variations. J’expliquerai par la suite mon code.

Pour la France :

name_fr_rm$categorie <- NA #on crée la colonne de catégorie

tendance <- function(mobilemoy) {
  if (all(diff(mobilemoy, na.rm = TRUE) < 0, na.rm = TRUE)) {
    return('Baisse continue')
  } else if (all(diff(mobilemoy, na.rm = TRUE) > 0, na.rm = TRUE)) {
    return('Hausse continue')
  } else if (!is.na(which.max(mobilemoy)) & !is.na(which.min(mobilemoy)) & which.max(mobilemoy) < which.min(mobilemoy)) {
    return('Populaire suivi d\'un déclin')
  } else if (!is.na(which.max(mobilemoy)) & !is.na(which.min(mobilemoy)) & which.max(mobilemoy) > which.min(mobilemoy)) {
    return('Déclin suivi d\'un regain de popularité')
  }
}

for (name in unique(name_fr_rm$name)) {
  groupbyprenom <- name_fr_rm[name_fr_rm$name == name, ]
  truc <- tendance(groupbyprenom$moy_mobile)
  name_fr_rm[name_fr_rm$name == name, 'categorie'] <- truc
}

unique(name_fr_rm[, c('name', 'categorie')])

## # A tibble: 1,857 × 2
## # Groups:   name [1,857]
##    name       categorie                             
##    <chr>      <chr>                                 
##  1 AARON      Hausse continue                       
##  2 ABDALLAH   Hausse continue                       
##  3 ABDEL      Déclin suivi d'un regain de popularité
##  4 ABDELAZIZ  Baisse continue                       
##  5 ABDELKADER Déclin suivi d'un regain de popularité
##  6 ABDELKRIM  Déclin suivi d'un regain de popularité
##  7 ABEL       Déclin suivi d'un regain de popularité
##  8 ACHILLE    Déclin suivi d'un regain de popularité
##  9 ADAM       Hausse continue                       
## 10 ADEL       Déclin suivi d'un regain de popularité
## # ℹ 1,847 more rows

Dans notre fonction “tendance” qui va catégoriser chaque prénom, nous utilisons la fonction diff() qui calcule la différence entre les valeurs de la moyenne mobile, en igorant les valeurs manquantes grâce à na.rm=TRUE (cf. https://thinkr.fr/abcdr/comment-gerer-les-donnees-manquantes-lors-dune-operation-grace-au-parametre-na-rm/). Je le met partout par tatonnement, pour que le code marche…

(all(diff(mobilemoy, na.rm = TRUE) < 0, na.rm = TRUE)) : on vérifie si toutes les différences des moyennes mobiles du prénom sont négatives. Si c’est le cas, alors c’est une baisse continue de popularité. Si ce n’est pas le cas, on passe à un autre “else if..” :

else if (all(diff(mobilemoy, na.rm = TRUE) > 0, na.rm = TRUE)) : c’est lan même chose mais pour la hausse. Si toutes les différences des moyennes mobiles du prénom donné sont positives, alors c’est une hausse continue de popularité.

Si ce n’est dans aucun de ces deux cas, on vérifie si c’est une hausse PUIS un déclin de popularité ou l’inverse grâce aux deux else if suivants :

<< Else if (!is.na(which.max(mobilemoy)) & !is.na(which.min(mobilemoy)) & which.max(mobilemoy) < which.min(mobilemoy)) { return(‘Populaire suivi d\’un déclin’) } else if (!is.na(which.max(mobilemoy)) & !is.na(which.min(mobilemoy)) & which.max(mobilemoy) > which.min(mobilemoy)) { return(‘Déclin suivi d\’un regain de popularité’) >>

Avec !is.na(which.max(mobilemoy)) & !is.na(which.min(mobilemoy)) on vérifie que les valeurs renvoyées par which.max et which.min ne sont pas des NA.

Ensuite, pour utiliser la fonction, j’utilise une boucle for qui va parcourir chaque prénom de la base de données ( for (name in unique(name_fr_rm$name)) ). Ici c’est comme un SELECT DISTINCT.

Ensuite je vais faire groupbyprenom <- name_fr_rm\[name_fr_rm\$name == name, \], ça va donc prendre en compte uniquement les lignes suivantes (donc les années suivantes) dont le prénom est identique à celui actuellement pris dans la boucle for du début. Ca nous fait comme une mini base de données d’un unique prénom pour toutes les années.

A celà on va appliquer notre fonction tendance expliquée plus haut, sur les p associés au prénom de la boucle for. Cela va nous renvoyer la catégorie. Nous l’avons appelé truc par manque d’inspiration et pour ne pas nous mélanger les pinceaux avec la colonne catégorie que nous avons créé.

A la fin, j’associe la catégorie du prénom (‘truc’) à la colonne catégorie de notre base de donnée pour chaque année ou le prénom est identique au prénom actuellement étudié de la boucle for. name_fr_rm\[name_fr_rm\$name == name, 'categorie'\] <- truc.

On peut faire la même chose pour les us :

Pour les USA :

name_us_rm$categorie <- NA
for (name in unique(name_us_rm$name)) {
  groupbyprenom <- name_us_rm[name_us_rm$name == name, ]
  truc <- tendance(groupbyprenom$moy_mobile)
  name_us_rm[name_us_rm$name == name, 'categorie'] <- truc
}

unique(name_us_rm[, c('name', 'categorie')])

## # A tibble: 1,608 × 2
## # Groups:   name [1,608]
##    name    categorie                             
##    <chr>   <chr>                                 
##  1 Aaden   Baisse continue                       
##  2 Aaliyah Déclin suivi d'un regain de popularité
##  3 Aaron   Déclin suivi d'un regain de popularité
##  4 Abby    Déclin suivi d'un regain de popularité
##  5 Abel    Hausse continue                       
##  6 Abigail Déclin suivi d'un regain de popularité
##  7 Abraham Déclin suivi d'un regain de popularité
##  8 Ace     Baisse continue                       
##  9 Adaline Baisse continue                       
## 10 Adalyn  Hausse continue                       
## # ℹ 1,598 more rows

Nous avons utilisé des boucles if, elif et for comme dans python car nous manipulons ce language depuis la première année de licence et il était donc plus facile pour nous d’essayer comme cela. Nous pensons que ce code n’est pas optimisé et pas parfait car si on regarde par exemple le premier prénom de la table française (Aaron), on remarque que notre code renvoie “Hausse continue”. Or ce prénom n’est apparu dans les 300 prénoms les plus donnés qu’à partir de 2004. Il a connu une hausse continue que depuis 2004. Le code n’a pas pu prendre en compte que le prénom n’existait pas avant.